home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 1 Issue 2 / PDCD-1 - Issue 02.iso / _utilities / utilities / 001 / fue / c / EVAL < prev    next >
Text File  |  1991-06-01  |  48KB  |  1,349 lines
  1. /*      EVAL.C: Expresion evaluation functions for
  2.                 MicroEMACS
  3.  
  4.         written 1986 by Daniel Lawrence                         */
  5.  
  6. /*      Modifications:
  7.         29-Sep-89       Mike Burrow (INMOS)     Added folding.
  8.           -May-91       Div                     Added cftype env var for riscos
  9. */
  10.  
  11. #include        <stdio.h>
  12. #include        "estruct.h"
  13. #include        "etype.h"
  14. #include        "edef.h"
  15. #include        "elang.h"
  16. #include        "evar.h"
  17.  
  18.  
  19. /*{{{  PASCAL NEAR varinit()*/
  20. PASCAL NEAR varinit()   /* initialize the user variable list */
  21.  
  22. {
  23.         register int i;
  24.  
  25.         for (i=0; i < MAXVARS; i++)
  26.                 uv[i].u_name[0] = 0;
  27. }
  28. /*}}}*/
  29.  
  30. /*{{{  PASCAL NEAR varclean()*/
  31. PASCAL NEAR varclean()  /* initialize the user variable list */
  32.  
  33. {
  34.         register int i;
  35.  
  36.         for (i=0; i < MAXVARS; i++)
  37.                 if (uv[i].u_name[0] != 0)
  38.                         free(uv[i].u_value);
  39. }
  40. /*}}}*/
  41.  
  42. /*{{{  char *PASCAL NEAR gtfun(fname)*/
  43. char *PASCAL NEAR gtfun(fname)  /* evaluate a function */
  44.  
  45. char *fname;            /* name of function to evaluate */
  46.  
  47. {
  48.         register int fnum;              /* index to function to eval */
  49.         register int arg;               /* value of some arguments */
  50.         char arg1[NSTRING];             /* value of first argument */
  51.         char arg2[NSTRING];             /* value of second argument */
  52.         char arg3[NSTRING];             /* value of third argument */
  53.         static char result[2 * NSTRING];        /* string result */
  54. #if     ENVFUNC
  55.         char *getenv();                 /* get environment string */
  56. #endif
  57.  
  58.         /* look the function up in the function table */
  59.         fname[3] = 0;   /* only first 3 chars significant */
  60.         mklower(fname); /* and let it be upper or lower case */
  61. #if     BINARY
  62.         fnum = binary(fname, funval, NFUNCS);
  63.  
  64.         /* return errorm on a bad reference */
  65.         if (fnum == -1)
  66.                 return(errorm);
  67. #else
  68.         for (fnum = 0; fnum < NFUNCS; fnum++)
  69.                 if (strcmp(fname, funcs[fnum].f_name) == 0)
  70.                         break;
  71.  
  72.         /* return errorm on a bad reference */
  73.         if (fnum == NFUNCS)
  74.                 return(errorm);
  75. #endif
  76.  
  77.         /* if needed, retrieve the first argument */
  78.         if (funcs[fnum].f_type >= MONAMIC) {
  79.                 if (macarg(arg1) != TRUE)
  80.                         return(errorm);
  81.  
  82.                 /* if needed, retrieve the second argument */
  83.                 if (funcs[fnum].f_type >= DYNAMIC) {
  84.                         if (macarg(arg2) != TRUE)
  85.                                 return(errorm);
  86.  
  87.                         /* if needed, retrieve the third argument */
  88.                         if (funcs[fnum].f_type >= TRINAMIC)
  89.                                 if (macarg(arg3) != TRUE)
  90.                                         return(errorm);
  91.                 }
  92.         }
  93.  
  94.  
  95.         /* and now evaluate it! */
  96.         switch (fnum) {
  97.                 case UFADD:     return(int_asc(asc_int(arg1) + asc_int(arg2)));
  98.                 case UFSUB:     return(int_asc(asc_int(arg1) - asc_int(arg2)));
  99.                 case UFTIMES:   return(int_asc(asc_int(arg1) * asc_int(arg2)));
  100.                 case UFDIV:     return(int_asc(asc_int(arg1) / asc_int(arg2)));
  101.                 case UFMOD:     return(int_asc(asc_int(arg1) % asc_int(arg2)));
  102.                 case UFNEG:     return(int_asc(-asc_int(arg1)));
  103.                 case UFCAT:     strcpy(result, arg1);
  104.                                 return(strcat(result, arg2));
  105.                 case UFLEFT:    return(bytecopy(result, arg1, asc_int(arg2)));
  106.                 case UFRIGHT:   arg = asc_int(arg2);
  107.                                 if (arg > strlen(arg1))
  108.                                         arg = strlen(arg1);
  109.                                 return(strcpy(result,
  110.                                         &arg1[strlen(arg1) - arg]));
  111.                 case UFMID:     arg = asc_int(arg2);
  112.                                 if (arg > strlen(arg1))
  113.                                         arg = strlen(arg1);
  114.                                 return(bytecopy(result, &arg1[arg-1],
  115.                                         asc_int(arg3)));
  116.                 case UFNOT:     return(ltos(stol(arg1) == FALSE));
  117.                 case UFEQUAL:   return(ltos(asc_int(arg1) == asc_int(arg2)));
  118.                 case UFLESS:    return(ltos(asc_int(arg1) < asc_int(arg2)));
  119.                 case UFGREATER: return(ltos(asc_int(arg1) > asc_int(arg2)));
  120.                 case UFSEQUAL:  return(ltos(strcmp(arg1, arg2) == 0));
  121.                 case UFSLESS:   return(ltos(strcmp(arg1, arg2) < 0));
  122.                 case UFSGREAT:  return(ltos(strcmp(arg1, arg2) > 0));
  123.                 case UFIND:     return(strcpy(result, fixnull(getval(arg1))));
  124.                 case UFAND:     return(ltos(stol(arg1) && stol(arg2)));
  125.                 case UFOR:      return(ltos(stol(arg1) || stol(arg2)));
  126.                 case UFLENGTH:  return(int_asc(strlen(arg1)));
  127.                 case UFUPPER:   return(mkupper(arg1));
  128.                 case UFLOWER:   return(mklower(arg1));
  129.                 case UFTRUTH:   return(ltos(asc_int(arg1) == 42));
  130.                 case UFASCII:   return(int_asc((int)arg1[0]));
  131.                 case UFCHR:     result[0] = asc_int(arg1);
  132.                                 result[1] = 0;
  133.                                 return(result);
  134.                 case UFGTCMD:   cmdstr(getcmd(), result);
  135.                                 return(result);
  136.                 case UFGTKEY:   result[0] = tgetc();
  137.                                 result[1] = 0;
  138.                                 return(result);
  139.                 case UFRND:     return(int_asc((ernd() % absv(asc_int(arg1))) + 1));
  140.                 case UFABS:     return(int_asc(absv(asc_int(arg1))));
  141.                 case UFSINDEX:  return(int_asc(sindex(arg1, arg2)));
  142.                 case UFENV:
  143. #if     ENVFUNC
  144.                                 return(fixnull(getenv(arg1)));
  145. #else
  146.                                 return("");
  147. #endif
  148.                 case UFBIND:    return(transbind(arg1));
  149.                 case UFEXIST:   return(ltos(fexist(arg1)));
  150.                 case UFFIND:
  151.                                 return(fixnull(flook(arg1, TRUE)));
  152.                 case UFBAND:    return(int_asc(asc_int(arg1) & asc_int(arg2)));
  153.                 case UFBOR:     return(int_asc(asc_int(arg1) | asc_int(arg2)));
  154.                 case UFBXOR:    return(int_asc(asc_int(arg1) ^ asc_int(arg2)));
  155.                 case UFBNOT:    return(int_asc(~asc_int(arg1)));
  156.                 case UFXLATE:   return(xlat(arg1, arg2, arg3));
  157.                 case UFTRIM:    return(trimstr(arg1));
  158.                 case UFSLOWER:  return(setlower(arg1, arg2), "");
  159.                 case UFSUPPER:  return(setupper(arg1, arg2), "");
  160.         }
  161.  
  162.         meexit(-11);    /* never should get here */
  163. }
  164. /*}}}*/
  165.  
  166. /*{{{  char *PASCAL NEAR gtusr(vname)*/
  167. char *PASCAL NEAR gtusr(vname)  /* look up a user var's value */
  168.  
  169. char *vname;            /* name of user variable to fetch */
  170.  
  171. {
  172.         register int vnum;      /* ordinal number of user var */
  173.         register char *vptr;    /* temp pointer to function value */
  174.  
  175.         /* scan the list looking for the user var name */
  176.         for (vnum = 0; vnum < MAXVARS; vnum++) {
  177.                 if (uv[vnum].u_name[0] == 0)
  178.                         return(errorm);
  179.                 if (strcmp(vname, uv[vnum].u_name) == 0) {
  180.                         vptr = uv[vnum].u_value;
  181.                         if (vptr)
  182.                                 return(vptr);
  183.                         else
  184.                                 return(errorm);
  185.                 }
  186.         }
  187.  
  188.         /* return errorm if we run off the end */
  189.         return(errorm);
  190. }
  191. /*}}}*/
  192.  
  193. #if     BINARY
  194.  
  195. /*{{{  char *PASCAL NEAR funval(i)*/
  196. char *PASCAL NEAR funval(i)
  197.  
  198. int i;
  199.  
  200. {
  201.         return(funcs[i].f_name);
  202. }
  203. /*}}}*/
  204.  
  205. /*{{{  char *PASCAL NEAR envval(i)*/
  206. char *PASCAL NEAR envval(i)
  207.  
  208. int i;
  209.  
  210. {
  211.         return(envars[i]);
  212. }
  213. /*}}}*/
  214.  
  215. /*{{{  PASCAL NEAR binary(key, tval, tlength)*/
  216. PASCAL NEAR binary(key, tval, tlength)
  217.  
  218. char *key;              /* key string to look for */
  219. char *(PASCAL NEAR *tval)();    /* ptr to function to fetch table value with */
  220. int tlength;            /* length of table to search */
  221.  
  222. {
  223.         int l, u;       /* lower and upper limits of binary search */
  224.         int i;          /* current search index */
  225.         int cresult;    /* result of comparison */
  226.  
  227.         /* set current search limit as entire list */
  228.         l = 0;
  229.         u = tlength - 1;
  230.  
  231.         /* get the midpoint! */
  232.         while (u >= l) {
  233.                 i = (l + u) >> 1;
  234.  
  235.                 /* do the comparison */
  236.                 cresult = strcmp(key, (*tval)(i));
  237.                 if (cresult == 0)
  238.                         return(i);
  239.                 if (cresult < 0)
  240.                         u = i - 1;
  241.                 else
  242.                         l = i + 1;
  243.         }
  244.         return(-1);
  245. }
  246. /*}}}*/
  247.  
  248. #endif
  249.  
  250.  
  251. /* Convert line type into a string */
  252. /*{{{  char *PASCAL NEAR ltypetos(ltype)*/
  253. char *PASCAL NEAR ltypetos(ltype)
  254. int ltype;
  255. {
  256.         switch(ltype) {
  257.                 case LEOEFOLD : return("LEOEFOLD");
  258.                 case LSOEFOLD : return("LSOEFOLD");
  259.                 case LEOFOLD  : return("LEOFOLD");
  260.                 case LSOFOLD  : return("LSOFOLD");
  261.                 default       : return("LNORMAL");
  262.         }
  263. }
  264. /*}}}*/
  265.  
  266.  
  267. /*{{{  char *PASCAL NEAR gtenv(vname)*/
  268. char *PASCAL NEAR gtenv(vname)
  269.  
  270. char *vname;            /* name of environment variable to retrieve */
  271.  
  272. {
  273.         register int vnum;      /* ordinal number of var refrenced */
  274.         static char result[2 * NSTRING];        /* string result */
  275.  
  276.         /* scan the list, looking for the referenced name */
  277. #if     BINARY
  278.         vnum = binary(vname, envval, NEVARS);
  279.  
  280.         /* return errorm on a bad reference */
  281.         if (vnum == -1)
  282.                 return(errorm);
  283. #else
  284.         for (vnum = 0; vnum < NEVARS; vnum++)
  285.                 if (strcmp(vname, envars[vnum]) == 0)
  286.                         break;
  287.  
  288.         /* return errorm on a bad reference */
  289.         if (vnum == NEVARS)
  290.                 return(errorm);
  291. #endif
  292.  
  293.         /* otherwise, fetch the appropriate value */
  294.         switch (vnum) {
  295.                 case EVFILLCOL: return(int_asc(fillcol));
  296.                 case EVPAGELEN: return(int_asc(term.t_nrow + 1));
  297.                 case EVCURCOL:  return(int_asc(getccol(FALSE)));
  298.                 case EVCURLINE: return(int_asc(getcline()));
  299.                 case EVRAM:     return(int_asc((int)(envram / 1024l)));
  300.                 case EVFLICKER: return(ltos(flickcode));
  301.                 case EVCURWIDTH:return(int_asc(term.t_ncol));
  302.                 case EVCBFLAGS: return(int_asc(curbp->b_flag));
  303.                 case EVCBUFNAME:return(curbp->b_bname);
  304.                 case EVCFNAME:  return(curbp->b_fname);
  305.                 case EVCFTYPE:  return(curbp->b_ftype);   /* div */
  306.                 case EVSRES:    return(sres);
  307.                 case EVDEBUG:   return(ltos(macbug));
  308.                 case EVSTATUS:  return(ltos(cmdstatus));
  309.                 case EVPALETTE: return(palstr);
  310.                 case EVASAVE:   return(int_asc(gasave));
  311.                 case EVACOUNT:  return(int_asc(gacount));
  312.                 case EVLASTKEY: return(int_asc(lastkey));
  313.                 case EVCURCHAR:
  314.                         return(curwp->w_dotp->l_used ==
  315.                                         curwp->w_doto ? int_asc('\r') :
  316.                                 int_asc(lgetc(curwp->w_dotp, curwp->w_doto)));
  317.                 case EVDISCMD:  return(ltos(discmd));
  318.                 case EVVERSION: return(VERSION);
  319.                 case EVPROGNAME:return(PROGNAME);
  320.                 case EVLANG:    return(LANGUAGE);
  321.                 case EVSEED:    return(int_asc(seed));
  322.                 case EVDISINP:  return(ltos(disinp));
  323.                 case EVWLINE:   return(int_asc(curwp->w_ntrows));
  324.                 case EVCWLINE:  return(int_asc(getwpos()));
  325.                 case EVTARGET:  saveflag = lastflag;
  326.                                 return(int_asc(curgoal));
  327.                 case EVSEARCH:  return(pat);
  328.                 case EVTIME:    return(timeset());
  329.                 case EVREPLACE: return(rpat);
  330.                 case EVMATCH:   return(fixnull(patmatch));
  331.                 case EVKILL:    return(getkill());
  332.                 case EVREGION:  return(getreg());
  333.                 case EVCMODE:   return(int_asc(curbp->b_mode));
  334.                 case EVGMODE:   return(int_asc(gmode));
  335.                 case EVTPAUSE:  return(int_asc(term.t_pause));
  336.                 case EVPENDING:
  337. #if     TYPEAH
  338.                                 return(ltos(typahead()));
  339. #else
  340.                                 return(falsem);
  341. #endif
  342.                 case EVLWIDTH:  return(int_asc(llength(curwp->w_dotp)));
  343.                 case EVLINE:    return(getctext());
  344.                 case EVGFLAGS:  return(int_asc(gflags));
  345.                 case EVRVAL:    return(int_asc(rval));
  346.                 case EVREADHK:  return(fixnull(getfname(&readhook)));
  347.                 case EVWRAPHK:  return(fixnull(getfname(&wraphook)));
  348.                 case EVCMDHK:   return(fixnull(getfname(&cmdhook)));
  349.                 case EVXPOS:    return(int_asc(xpos));
  350.                 case EVYPOS:    return(int_asc(ypos));
  351.                 case EVSTERM:   cmdstr(sterm, result);
  352.                                 return(result);
  353.                 case EVMODEFLAG:return(ltos(modeflag));
  354.                 case EVSSCROLL: return(ltos(sscroll));
  355.                 case EVLASTMESG:return(lastmesg);
  356.                 case EVHARDTAB: return(int_asc(tabsize));
  357.                 case EVSOFTTAB: return(int_asc(stabsize));
  358.                 case EVSSAVE:   return(ltos(ssave));
  359.                 case EVFCOL:    return(int_asc(curwp->w_fcol));
  360.                 case EVHSCROLL: return(ltos(hscroll));
  361.                 case EVHJUMP:   return(int_asc(hjump));
  362.                 case EVBUFHOOK: return(fixnull(getfname(&bufhook)));
  363.                 case EVEXBHOOK: return(fixnull(getfname(&exbhook)));
  364.                 case EVWRITEHK: return(fixnull(getfname(&writehook)));
  365.                 case EVDIAGFLAG:return(ltos(diagflag));
  366.                 case EVMSFLAG:  return(ltos(mouseflag));
  367.                 case EVOCRYPT:  return(ltos(oldcrypt));
  368.                 case EVLTYPE:   return(ltypetos(curwp->w_dotp->l_type));
  369.                 case EVLMARGIN: return(int_asc(curwp->w_dotp->l_lmargin));
  370.                 case EVZPOS:    return(int_asc((int)curbp->b_nfolds));
  371.         }
  372.         meexit(-12);    /* again, we should never get here */
  373. }
  374. /*}}}*/
  375.  
  376. /*{{{  char *PASCAL NEAR fixnull(s)    -- Don't return NULL pointers!*/
  377. char *PASCAL NEAR fixnull(s)    /* Don't return NULL pointers! */
  378.  
  379. char *s;
  380.  
  381. {
  382.         if (s == NULL)
  383.                 return("");
  384.         else
  385.                 return(s);
  386. }
  387. /*}}}*/
  388.  
  389. /*{{{  char *PASCAL NEAR getkill()    --return some of the contents of the kill buffer*/
  390. char *PASCAL NEAR getkill()     /* return some of the contents of the kill buffer */
  391.  
  392. {
  393.         register int size;      /* max number of chars to return */
  394.         char value[NSTRING];    /* temp buffer for value */
  395.  
  396.         if (kbufh == NULL)
  397.                 /* no kill buffer....just a null string */
  398.                 value[0] = 0;
  399.         else {
  400.                 /* copy in the contents... */
  401.                 if (kused < NSTRING)
  402.                         size = kused;
  403.                 else
  404.                         size = NSTRING - 1;
  405.                 bytecopy(value, kbufh->d_chunk, size);
  406.         }
  407.  
  408.         /* and return the constructed value */
  409.         return(value);
  410. }
  411. /*}}}*/
  412.  
  413. /*{{{  char *PASCAL NEAR trimstr(s)*/
  414. char *PASCAL NEAR trimstr(s)
  415. /* trim whitespace off the end of a string  */
  416.  
  417. char *s;        /* string to trim */
  418.  
  419. {
  420.         char *sp;       /* backward index */
  421.  
  422.         sp = s + strlen(s) - 1;
  423.         while ((sp >= s) && (*sp == ' ' || *sp == '\t'))
  424.                 --sp;
  425.         *(sp+1) = 0;
  426.         return(s);
  427. }
  428. /*}}}*/
  429.  
  430. /*{{{  int PASCAL NEAR setvar(f, n)*/
  431. int PASCAL NEAR setvar(f, n)            /* set a variable */
  432.  
  433. int f;          /* default flag */
  434. int n;          /* numeric arg (can overide prompted value) */
  435.  
  436. {
  437.         register int status;    /* status return */
  438.         VDESC vd;               /* variable num/type */
  439.         char var[NVSIZE+1];     /* name of variable to fetch */
  440.         char value[NSTRING];    /* value to set variable to */
  441.  
  442.         /* first get the variable to set.. */
  443.         if (clexec == FALSE) {
  444.                 status = mlreply(TEXT51, &var[0], NVSIZE+1);
  445. /*                               "Variable to set: " */
  446.                 if (status != TRUE)
  447.                         return(status);
  448.         } else {        /* macro line argument */
  449.                 /* grab token and skip it */
  450.                 execstr = token(execstr, var, NVSIZE + 1);
  451.         }
  452.  
  453.         /* check the legality and find the var */
  454.         findvar(var, &vd, NVSIZE + 1);
  455.         
  456.         /* if its not legal....bitch */
  457.         if (vd.v_type == -1) {
  458.                 mlwrite(TEXT52, var);
  459. /*                      "%%No such variable as '%s'" */
  460.                 return(FALSE);
  461.         }
  462.  
  463.         /* get the value for that variable */
  464.         if (f == TRUE)
  465.                 strcpy(value, int_asc(n));
  466.         else {
  467.                 status = mlreply(TEXT53, &value[0], NSTRING);
  468. /*                               "Value: " */
  469.                 if (status != TRUE)
  470.                         return(status);
  471.         }
  472.  
  473.         /* and set the appropriate value */
  474.         status = svar(&vd, value);
  475.  
  476. #if     DEBUGM
  477.         /* if $debug == TRUE, every assignment will echo a statment to
  478.            that effect here. */
  479.         
  480.         if (macbug && (strcmp(var, "%track") != 0)) {
  481.                 strcpy(outline, "(((");
  482.  
  483.                 strcat(outline, var);
  484.                 strcat(outline, " <- ");
  485.  
  486.                 /* and lastly the value we tried to assign */
  487.                 strcat(outline, value);
  488.                 strcat(outline, ")))");
  489.  
  490.                 /* expand '%' to "%%" so mlwrite wont bitch */
  491.                 makelit(outline);
  492.  
  493.                 /* write out the debug line */
  494.                 mlforce(outline);
  495.                 update(TRUE);
  496.  
  497.                 /* and get the keystroke to hold the output */
  498.                 if (getkey() == abortc) {
  499.                         mlforce(TEXT54);
  500. /*                              "[Macro aborted]" */
  501.                         status = FALSE;
  502.                 }
  503.         }
  504. #endif
  505.  
  506.         /* and return it */
  507.         return(status);
  508. }
  509. /*}}}*/
  510.  
  511. /*{{{  PASCAL NEAR findvar(var, vd, size)*/
  512. PASCAL NEAR findvar(var, vd, size)      /* find a variables type and name */
  513.  
  514. char *var;      /* name of var to get */
  515. VDESC *vd;      /* structure to hold type and ptr */
  516. int size;       /* size of var array */
  517.  
  518. {
  519.         register int vnum;      /* subscript in varable arrays */
  520.         register int vtype;     /* type to return */
  521.  
  522. fvar:   vtype = -1;
  523.         switch (var[0]) {
  524.  
  525.                 case '$': /* check for legal enviromnent var */
  526.                         for (vnum = 0; vnum < NEVARS; vnum++)
  527.                                 if (strcmp(&var[1], envars[vnum]) == 0) {
  528.                                         vtype = TKENV;
  529.                                         break;
  530.                                 }
  531.                         break;
  532.  
  533.                 case '%': /* check for existing legal user variable */
  534.                         for (vnum = 0; vnum < MAXVARS; vnum++)
  535.                                 if (strcmp(&var[1], uv[vnum].u_name) == 0) {
  536.                                         vtype = TKVAR;
  537.                                         break;
  538.                                 }
  539.                         if (vnum < MAXVARS)
  540.                                 break;
  541.  
  542.                         /* create a new one??? */
  543.                         for (vnum = 0; vnum < MAXVARS; vnum++)
  544.                                 if (uv[vnum].u_name[0] == 0) {
  545.                                         vtype = TKVAR;
  546.                                         strcpy(uv[vnum].u_name, &var[1]);
  547.                                         uv[vnum].u_value = NULL;
  548.                                         break;
  549.                                 }
  550.                         break;
  551.  
  552.                 case '&':       /* indirect operator? */
  553.                         var[4] = 0;
  554.                         if (strcmp(&var[1], "ind") == 0) {
  555.                                 /* grab token, and eval it */
  556.                                 execstr = token(execstr, var, size);
  557.                                 strcpy(var, fixnull(getval(var)));
  558.                                 goto fvar;
  559.                         }
  560.         }
  561.  
  562.         /* return the results */
  563.         vd->v_num = vnum;
  564.         vd->v_type = vtype;
  565.         return;
  566. }
  567. /*}}}*/
  568.  
  569. /*{{{  int PASCAL NEAR svar(var, value)  */
  570. int PASCAL NEAR svar(var, value)        /* set a variable */
  571.  
  572. VDESC *var;     /* variable to set */
  573. char *value;    /* value to set to */
  574.  
  575. {
  576.         register int vnum;      /* ordinal number of var refrenced */
  577.         register int vtype;     /* type of variable to set */
  578.         register int status;    /* status return */
  579.         register int c;         /* translated character */
  580.         register char * sp;     /* scratch string pointer */
  581.  
  582.         /* simplify the vd structure (we are gonna look at it a lot) */
  583.         vnum = var->v_num;
  584.         vtype = var->v_type;
  585.  
  586.         /* and set the appropriate value */
  587.         status = TRUE;
  588.         switch (vtype) {
  589.         case TKVAR: /* set a user variable */
  590.                 if (uv[vnum].u_value != NULL)
  591.                         free(uv[vnum].u_value);
  592.                 sp = malloc(strlen(value) + 1);
  593.                 if (sp == NULL)
  594.                         return(FALSE);
  595.                 strcpy(sp, value);
  596.                 uv[vnum].u_value = sp;
  597.                 break;
  598.  
  599.         case TKENV: /* set an environment variable */
  600.                 status = TRUE;  /* by default */
  601.                 switch (vnum) {
  602.                 case EVFILLCOL: fillcol = asc_int(value);
  603.                                 break;
  604.                 case EVPAGELEN: status = newsize(TRUE, asc_int(value));
  605.                                 break;
  606.                 case EVCURCOL:  status = setccol(asc_int(value));
  607.                                 break;
  608.                 case EVCURLINE: status = gotoline(TRUE, asc_int(value));
  609.                                 break;
  610.                 case EVRAM:     break;
  611.                 case EVFLICKER: flickcode = stol(value);
  612.                                 break;
  613.                 case EVCURWIDTH:status = newwidth(TRUE, asc_int(value));
  614.                                 break;
  615.                 case EVCBFLAGS: curbp->b_flag = (curbp->b_flag & ~(BFCHG|BFINVS))
  616.                                         | (asc_int(value) & (BFCHG&BFINVS));
  617.                                 lchange(WFMODE);
  618.                                 break;
  619.                 case EVCBUFNAME:strcpy(curbp->b_bname, value);
  620.                                 curwp->w_flag |= WFMODE;
  621.                                 break;
  622.                 case EVCFNAME:  strcpy(curbp->b_fname, value);      /* div */
  623.                                 getftype(value, curbp->b_ftype);
  624.                                 curwp->w_flag |= WFMODE;
  625.                                 break;
  626.                 case EVCFTYPE:  strcpy(curbp->b_ftype, value);
  627.                                 curwp->w_flag |= WFMODE;
  628.                                 break;
  629.                 case EVSRES:    status = TTrez(value);
  630.                                 break;
  631.                 case EVDEBUG:   macbug = stol(value);
  632.                                 break;
  633.                 case EVSTATUS:  cmdstatus = stol(value);
  634.                                 break;
  635.                 case EVPALETTE: bytecopy(palstr, value, 48);
  636.                                 spal(palstr);
  637.                                 break;
  638.                 case EVASAVE:   gasave = asc_int(value);
  639.                                 break;
  640.                 case EVACOUNT:  gacount = asc_int(value);
  641.                                 break;
  642.                 case EVLASTKEY: lastkey = asc_int(value);
  643.                                 break;
  644.                 case EVCURCHAR: ldelete(1L, FALSE, FALSE, TRUE);        /* delete 1 char */
  645.                                 c = asc_int(value);
  646.                                 if (c == '\r')
  647.                                         lnewline(FALSE, 1);
  648.                                 else
  649.                                         linsert(1, c, TRUE);
  650.                                 backchar(FALSE, 1);
  651.                                 break;
  652.                 case EVDISCMD:  discmd = stol(value);
  653.                                 break;
  654.                 case EVVERSION: break;
  655.                 case EVPROGNAME:break;
  656.                 case EVLANG:    break;
  657.                 case EVSEED:    seed = asc_int(value);
  658.                                 break;
  659.                 case EVDISINP:  disinp = stol(value);
  660.                                 break;
  661.                 case EVWLINE:   status = resize(TRUE, asc_int(value));
  662.                                 break;
  663.                 case EVCWLINE:  status = forwline(TRUE,
  664.                                                 asc_int(value) - getwpos(), FALSE);
  665.                                 break;
  666.                 case EVTARGET:  curgoal = asc_int(value);
  667.                                 thisflag = saveflag;
  668.                                 break;
  669.                 case EVSEARCH:  strcpy(pat, value);
  670.                                 setjtable(pat); /* Set up fast search arrays  */
  671. #if     MAGIC
  672.                                 mcclear();
  673. #endif
  674.                                 break;
  675.                 case EVTIME:    break;
  676.                 case EVREPLACE: strcpy(rpat, value);
  677.                                 break;
  678.                 case EVMATCH:   break;
  679.                 case EVKILL:    break;
  680.                 case EVREGION:  break;
  681.                 case EVCMODE:   curbp->b_mode = asc_int(value);
  682.                                 curwp->w_flag |= WFMODE;
  683.                                 break;
  684.                 case EVGMODE:   gmode = asc_int(value);
  685.                                 break;
  686.                 case EVTPAUSE:  term.t_pause = asc_int(value);
  687.                                 break;
  688.                 case EVPENDING: break;
  689.                 case EVLWIDTH:  break;
  690.                 case EVLINE:    putctext(value);
  691.                                 break;
  692.                 case EVGFLAGS:  gflags = asc_int(value);
  693.                                 break;
  694.                 case EVRVAL:    break;
  695.                 case EVREADHK:  setkey(&readhook, BINDFNC, value);
  696.                                 break;
  697.                 case EVWRAPHK:  setkey(&wraphook, BINDFNC, value);
  698.                                 break;
  699.                 case EVCMDHK:   setkey(&cmdhook, BINDFNC, value);
  700.                                 break;
  701.                 case EVXPOS:    xpos = asc_int(value);
  702.                                 break;
  703.                 case EVYPOS:    ypos = asc_int(value);
  704.                                 break;
  705.                 case EVSTERM:   sterm = stock(value);
  706.                                 break;
  707.                 case EVMODEFLAG:modeflag = stol(value);
  708.                                 upwind();
  709.                                 break;
  710.                 case EVSSCROLL: sscroll = stol(value);
  711.                                 break;
  712.                 case EVLASTMESG:strcpy(lastmesg, value);
  713.                                 break;
  714.                 case EVHARDTAB: tabsize = asc_int(value);
  715.                                 upwind();
  716.                                 break;
  717.                 case EVSOFTTAB: stabsize = asc_int(value);
  718.                                 upwind();
  719.                                 break;
  720.                 case EVSSAVE:   ssave = stol(value);
  721.                                 break;
  722.                 case EVFCOL:    curwp->w_fcol = asc_int(value);
  723.                                 if (curwp->w_fcol < 0)
  724.                                         curwp->w_fcol = 0;
  725.                                 curwp->w_flag |= WFHARD | WFMODE;
  726.                                 break;
  727.                 case EVHSCROLL: hscroll = stol(value);
  728.                                 lbound = 0;
  729.                                 break;
  730.                 case EVHJUMP:   hjump = asc_int(value);
  731.                                 if (hjump < 1)
  732.                                         hjump = 1;
  733.                                 if (hjump > term.t_ncol - 1)
  734.                                         hjump = term.t_ncol - 1;
  735.                                 break;
  736.                 case EVBUFHOOK: setkey(&bufhook, BINDFNC, value);
  737.                                 break;
  738.                 case EVEXBHOOK: setkey(&exbhook, BINDFNC, value);
  739.                                 break;
  740.                 case EVWRITEHK: setkey(&writehook, BINDFNC, value);
  741.                                 break;
  742.                 case EVDIAGFLAG:diagflag = stol(value);
  743.                                 break;
  744.                 case EVMSFLAG:  mouseflag = stol(value);
  745.                                 break;
  746.                 case EVOCRYPT:  oldcrypt = stol(value);
  747.                                 break;
  748.                 }
  749.                 break;
  750.         }
  751.         return(status);
  752. }
  753. /*}}}*/
  754.  
  755. /*      asc_int:        ascii string to integer......This is too
  756.                 inconsistant to use the system's        */
  757.  
  758. /*{{{  PASCAL NEAR asc_int(st)*/
  759. PASCAL NEAR asc_int(st)
  760.  
  761. char *st;
  762.  
  763. {
  764.         int result;     /* resulting number */
  765.         int sign;       /* sign of resulting number */
  766.         char c;         /* current char being examined */
  767.  
  768.         result = 0;
  769.         sign = 1;
  770.  
  771.         /* skip preceding whitespace */
  772.         while (*st == ' ' || *st == '\t')
  773.                 ++st;
  774.  
  775.         /* check for sign */
  776.         if (*st == '-') {
  777.                 sign = -1;
  778.                 ++st;
  779.         }
  780.         if (*st == '+')
  781.                 ++st;
  782.  
  783.         /* scan digits, build value */
  784.         while ((c = *st++))
  785.                 if (c >= '0' && c <= '9')
  786.                         result = result * 10 + c - '0';
  787.                 else
  788.                         break;
  789.  
  790.         return(result * sign);
  791. }
  792. /*}}}*/
  793.  
  794. /*      int_asc:        integer to ascii string.......... This is too
  795.                         inconsistant to use the system's        */
  796.  
  797. /*{{{  char *PASCAL NEAR int_asc(i)*/
  798. char *PASCAL NEAR int_asc(i)
  799.  
  800. int i;  /* integer to translate to a string */
  801.  
  802. {
  803.         register int digit;             /* current digit being used */
  804.         register char *sp;              /* pointer into result */
  805.         register int sign;              /* sign of resulting number */
  806.         static char result[INTWIDTH+1]; /* resulting string */
  807.  
  808.         /* record the sign...*/
  809.         sign = 1;
  810.         if (i < 0) {
  811.                 sign = -1;
  812.                 i = -i;
  813.         }
  814.  
  815.         /* and build the string (backwards!) */
  816.         sp = result + INTWIDTH;
  817.         *sp = 0;
  818.         do {
  819.                 digit = i % 10;
  820.                 *(--sp) = '0' + digit;  /* and install the new digit */
  821.                 i = i / 10;
  822.         } while (i);
  823.  
  824.         /* and fix the sign */
  825.         if (sign == -1) {
  826.                 *(--sp) = '-';  /* and install the minus sign */
  827.         }
  828.  
  829.         return(sp);
  830. }
  831. /*}}}*/
  832.  
  833. /*{{{  int PASCAL NEAR gettyp(token)*/
  834. int PASCAL NEAR gettyp(token)   /* find the type of a passed token */
  835.  
  836. char *token;    /* token to analyze */
  837.  
  838. {
  839.         register char c;        /* first char in token */
  840.  
  841.         /* grab the first char (this is all we need) */
  842.         c = *token;
  843.  
  844.         /* no blanks!!! */
  845.         if (c == 0)
  846.                 return(TKNUL);
  847.  
  848.         /* a numeric literal? */
  849.         if (c >= '0' && c <= '9')
  850.                 return(TKLIT);
  851.  
  852.         switch (c) {
  853.                 case '"':       return(TKSTR);
  854.  
  855.                 case '!':       return(TKDIR);
  856.                 case '@':       return(TKARG);
  857.                 case '#':       return(TKBUF);
  858.                 case '$':       return(TKENV);
  859.                 case '%':       return(TKVAR);
  860.                 case '&':       return(TKFUN);
  861.                 case '*':       return(TKLBL);
  862.  
  863.                 default:        return(TKCMD);
  864.         }
  865. }
  866. /*}}}*/
  867.  
  868. /*{{{  char *PASCAL NEAR getval(token)*/
  869. char *PASCAL NEAR getval(token) /* find the value of a token */
  870.  
  871. char *token;            /* token to evaluate */
  872.  
  873. {
  874.         register int status;    /* error return */
  875.         register BUFFER *bp;    /* temp buffer pointer */
  876.         register int blen;      /* length of buffer argument */
  877.         register int distmp;    /* temporary discmd flag */
  878.         static char buf[NSTRING];/* string buffer for some returns */
  879.  
  880.         switch (gettyp(token)) {
  881.                 case TKNUL:     return("");
  882.  
  883.                 case TKARG:     /* interactive argument */
  884.                                 strcpy(token, fixnull(getval(&token[1])));
  885.                                 distmp = discmd;        /* echo it always! */
  886.                                 discmd = TRUE;
  887.                                 status = getstring(token,
  888.                                            buf, NSTRING, ctoec('\r'));
  889.                                 discmd = distmp;
  890.                                 if (status == ABORT)
  891.                                         return(NULL);
  892.                                 return(buf);
  893.  
  894.                 case TKBUF:     /* buffer contents fetch */
  895.  
  896.                                 /* grab the right buffer */
  897.                                 strcpy(token, fixnull(getval(&token[1])));
  898.                                 bp = bfind(token, FALSE, 0);
  899.                                 if (bp == NULL)
  900.                                         return(NULL);
  901.                 
  902.                                 /* if the buffer is displayed, get the window
  903.                                    vars instead of the buffer vars */
  904.                                 if (bp->b_nwnd > 0) {
  905.                                         curbp->b_dotp = curwp->w_dotp;
  906.                                         curbp->b_doto = curwp->w_doto;
  907.                                 }
  908.  
  909.                                 /* make sure we are not at the end */
  910.                                 if (bp->b_linep == bp->b_dotp)
  911.                                         return(NULL);
  912.                 
  913.                                 /* grab the line as an argument */
  914.                                 blen = bp->b_dotp->l_used - bp->b_doto;
  915.                                 if (blen > NSTRING)
  916.                                         blen = NSTRING;
  917.                                 bytecopy(buf, bp->b_dotp->l_text + bp->b_doto,
  918.                                         blen);
  919.                                 buf[blen] = 0;
  920.                 
  921.                                 /* and step the buffer's line ptr ahead a line */
  922.                                 bp->b_dotp = bp->b_dotp->l_fp;
  923.                                 bp->b_doto = 0;
  924.  
  925.                                 /* if displayed buffer, reset window ptr vars*/
  926.                                 if (bp->b_nwnd > 0) {
  927.                                         curwp->w_dotp = curbp->b_dotp;
  928.                                         curwp->w_doto = 0;
  929.                                         curwp->w_flag |= WFMOVE;
  930.                                 }
  931.  
  932.                                 /* and return the spoils */
  933.                                 return(buf);            
  934.  
  935.                 case TKVAR:     return(gtusr(token+1));
  936.                 case TKENV:     return(gtenv(token+1));
  937.                 case TKFUN:     return(gtfun(token+1));
  938.                 case TKDIR:     return(NULL);
  939.                 case TKLBL:     return(NULL);
  940.                 case TKLIT:     return(token);
  941.                 case TKSTR:     return(token+1);
  942.                 case TKCMD:     return(token);
  943.         }
  944. }
  945. /*}}}*/
  946.  
  947. /*{{{  int PASCAL NEAR stol(val)*/
  948. int PASCAL NEAR stol(val)       /* convert a string to a numeric logical */
  949.  
  950. char *val;      /* value to check for stol */
  951.  
  952. {
  953.         /* check for logical values */
  954.         if (val[0] == 'F')
  955.                 return(FALSE);
  956.         if (val[0] == 'T')
  957.                 return(TRUE);
  958.  
  959.         /* check for numeric truth (!= 0) */
  960.         return((asc_int(val) != 0));
  961. }
  962. /*}}}*/
  963.  
  964. /*{{{  char *PASCAL NEAR ltos(val)*/
  965. char *PASCAL NEAR ltos(val)     /* numeric logical to string logical */
  966.  
  967. int val;        /* value to translate */
  968.  
  969. {
  970.         if (val)
  971.                 return(truem);
  972.         else
  973.                 return(falsem);
  974. }
  975. /*}}}*/
  976.  
  977. /*{{{  char *PASCAL NEAR mkupper(str)*/
  978. char *PASCAL NEAR mkupper(str)  /* make a string upper case */
  979.  
  980. char *str;              /* string to upper case */
  981.  
  982. {
  983.         char *sp;
  984.  
  985.         sp = str;
  986.         while (*sp)
  987.                 uppercase(sp++);
  988.         return(str);
  989. }
  990. /*}}}*/
  991.  
  992. /*{{{  char *PASCAL NEAR mklower(str)*/
  993. char *PASCAL NEAR mklower(str)  /* make a string lower case */
  994.  
  995. char *str;              /* string to lower case */
  996.  
  997. {
  998.         char *sp;
  999.  
  1000.         sp = str;
  1001.         while (*sp)
  1002.                 lowercase(sp++);
  1003.         return(str);
  1004. }
  1005. /*}}}*/
  1006.  
  1007. /*{{{  int PASCAL NEAR absv(x)*/
  1008. int PASCAL NEAR absv(x) /* take the absolute value of an integer */
  1009.  
  1010. int x;
  1011.  
  1012. {
  1013.         return(x < 0 ? -x : x);
  1014. }
  1015. /*}}}*/
  1016.  
  1017. /*{{{  int PASCAL NEAR ernd()*/
  1018. int PASCAL NEAR ernd()  /* returns a random integer */
  1019.  
  1020. {
  1021.         seed = absv(seed * 1721 + 10007);
  1022.         return(seed);
  1023. }
  1024. /*}}}*/
  1025.  
  1026. /*{{{  int PASCAL NEAR sindex(source, pattern)*/
  1027. int PASCAL NEAR sindex(source, pattern) /* find pattern within source */
  1028.  
  1029. char *source;   /* source string to search */
  1030. char *pattern;  /* string to look for */
  1031.  
  1032. {
  1033.         char *sp;       /* ptr to current position to scan */
  1034.         char *csp;      /* ptr to source string during comparison */
  1035.         char *cp;       /* ptr to place to check for equality */
  1036.  
  1037.         /* scanning through the source string */
  1038.         sp = source;
  1039.         while (*sp) {
  1040.                 /* scan through the pattern */
  1041.                 cp = pattern;
  1042.                 csp = sp;
  1043.                 while (*cp) {
  1044.                         if (!eq(*cp, *csp))
  1045.                                 break;
  1046.                         ++cp;
  1047.                         ++csp;
  1048.                 }
  1049.  
  1050.                 /* was it a match? */
  1051.                 if (*cp == 0)
  1052.                         return((int)(sp - source) + 1);
  1053.                 ++sp;
  1054.         }
  1055.  
  1056.         /* no match at all.. */
  1057.         return(0);
  1058. }
  1059. /*}}}*/
  1060.  
  1061. /*      Filter a string through a translation table     */
  1062.  
  1063. /*{{{  char *PASCAL NEAR xlat(source, lookup, trans)*/
  1064. char *PASCAL NEAR xlat(source, lookup, trans)
  1065.  
  1066. char *source;   /* string to filter */
  1067. char *lookup;   /* characters to translate */
  1068. char *trans;    /* resulting translated characters */
  1069.  
  1070. {
  1071.         register char *sp;      /* pointer into source table */
  1072.         register char *lp;      /* pointer into lookup table */
  1073.         register char *rp;      /* pointer into result */
  1074.         static char result[NSTRING];    /* temporary result */
  1075.  
  1076.         /* scan source string */
  1077.         sp = source;
  1078.         rp = result;
  1079.         while (*sp) {
  1080.                 /* scan lookup table for a match */
  1081.                 lp = lookup;
  1082.                 while (*lp) {
  1083.                         if (*sp == *lp) {
  1084.                                 *rp++ = trans[lp - lookup];
  1085.                                 goto xnext;
  1086.                         }
  1087.                         ++lp;
  1088.                 }
  1089.  
  1090.                 /* no match, copy in the source char untranslated */
  1091.                 *rp++ = *sp;
  1092.  
  1093. xnext:          ++sp;
  1094.         }
  1095.  
  1096.         /* terminate and return the result */
  1097.         *rp = 0;
  1098.         return(result);
  1099. }
  1100. /*}}}*/
  1101.  
  1102. #if     DEBUGM
  1103. /*{{{  int PASCAL NEAR dispvar(f, n) */
  1104. int PASCAL NEAR dispvar(f, n)           /* display a variable's value */
  1105.  
  1106. int f;          /* default flag */
  1107. int n;          /* numeric arg (can overide prompted value) */
  1108.  
  1109. {
  1110.         register int status;    /* status return */
  1111.         VDESC vd;               /* variable num/type */
  1112.         char var[NVSIZE+1];     /* name of variable to fetch */
  1113.  
  1114.         /* first get the variable to display.. */
  1115.         if (clexec == FALSE) {
  1116.                 status = mlreply(TEXT55, &var[0], NVSIZE+1);
  1117. /*                               "Variable to display: " */
  1118.                 if (status != TRUE)
  1119.                         return(status);
  1120.         } else {        /* macro line argument */
  1121.                 /* grab token and skip it */
  1122.                 execstr = token(execstr, var, NVSIZE + 1);
  1123.         }
  1124.  
  1125.         /* check the legality and find the var */
  1126.         findvar(var, &vd, NVSIZE + 1);
  1127.         
  1128.         /* if its not legal....bitch */
  1129.         if (vd.v_type == -1) {
  1130.                 mlwrite(TEXT52, var);
  1131. /*                      "%%No such variable as '%s'" */
  1132.                 return(FALSE);
  1133.         }
  1134.  
  1135.         /* and display the value */
  1136.         strcpy(outline, var);
  1137.         strcat(outline, " = ");
  1138.  
  1139.         /* and lastly the current value */
  1140.         strcat(outline, fixnull(getval(var)));
  1141.  
  1142.         /* expand '%' to "%%" so mlwrite wont bitch */
  1143.         makelit(outline);
  1144.  
  1145.         /* write out the result */
  1146.         mlforce(outline);
  1147.         update(TRUE);
  1148.  
  1149.         /* and return */
  1150.         return(TRUE);
  1151. }
  1152. /*}}}*/
  1153.  
  1154. /*      describe-variables      Bring up a fake buffer and list the contents
  1155.                                 of all the environment variables
  1156. */
  1157.  
  1158. PASCAL NEAR desvars(f, n)
  1159.  
  1160. {
  1161.         register WINDOW *wp;    /* scanning pointer to windows */
  1162.         register BUFFER *bp;    /* buffer to put binding list into */
  1163.         register int uindex;    /* index into uvar table */
  1164.         register int cmark;     /* current mark */
  1165.         char outseq[80];        /* output buffer for keystroke sequence */
  1166.  
  1167.         /* split the current window to make room for the variable list */
  1168.         if (splitwind(FALSE, 1) == FALSE)
  1169.                         return(FALSE);
  1170.  
  1171.         /* and get a buffer for it */
  1172.         bp = bfind(TEXT56, TRUE, 0);
  1173. /*                 "Variable list" */
  1174.         if (bp == NULL || bclear(bp) == FALSE) {
  1175.                 mlwrite(TEXT57);
  1176. /*                      "Can not display variable list" */
  1177.                 return(FALSE);
  1178.         }
  1179.  
  1180.         /* let us know this is in progress */
  1181.         mlwrite(TEXT58);
  1182. /*              "[Building variable list]" */
  1183.  
  1184.         /* disconect the current buffer */
  1185.         if (--curbp->b_nwnd == 0) {             /* Last use.            */
  1186.                 curbp->b_dotp  = curwp->w_dotp;
  1187.                 curbp->b_doto  = curwp->w_doto;
  1188.                 for (cmark = 0; cmark < NMARKS; cmark++) {
  1189.                         curbp->b_markp[cmark] = curwp->w_markp[cmark];
  1190.                         curbp->b_marko[cmark] = curwp->w_marko[cmark];
  1191.                 }
  1192.                 curbp->b_fcol  = curwp->w_fcol;
  1193.         }
  1194.  
  1195.         /* connect the current window to this buffer */
  1196.         curbp = bp;     /* make this buffer current in current window */
  1197.         bp->b_mode = 0;         /* no modes active in binding list */
  1198.         bp->b_nwnd++;           /* mark us as more in use */
  1199.         wp = curwp;
  1200.         wp->w_bufp = bp;
  1201.         wp->w_linep = bp->b_linep;
  1202.         wp->w_flag = WFHARD|WFFORCE;
  1203.         wp->w_dotp = bp->b_dotp;
  1204.         wp->w_doto = bp->b_doto;
  1205.         for (cmark = 0; cmark < NMARKS; cmark++) {
  1206.                 wp->w_markp[cmark] = NULL;
  1207.                 wp->w_marko[cmark] = 0;
  1208.         }
  1209.  
  1210.         /* build the environment variable list */
  1211.         for (uindex = 0; uindex < NEVARS; uindex++) {
  1212.  
  1213.                 /* add in the environment variable name */
  1214.                 strcpy(outseq, "$");
  1215.                 strcat(outseq, envars[uindex]);
  1216.                 pad(outseq, 14);
  1217.                 
  1218.                 /* add in the value */
  1219.                 strcat(outseq, gtenv(envars[uindex]));
  1220.                 strcat(outseq, "\r");
  1221.  
  1222.                 /* and add it as a line into the buffer */
  1223.                 if (linstr(outseq) != TRUE)
  1224.                         return(FALSE);
  1225.         }
  1226.  
  1227.         linstr("\r\r");
  1228.  
  1229.         /* build the user variable list */
  1230.         for (uindex = 0; uindex < MAXVARS; uindex++) {
  1231.                 if (uv[uindex].u_name[0] == 0)
  1232.                         break;
  1233.  
  1234.                 /* add in the user variable name */
  1235.                 strcpy(outseq, "%");
  1236.                 strcat(outseq, uv[uindex].u_name);
  1237.                 pad(outseq, 14);
  1238.                 
  1239.                 /* add in the value */
  1240.                 strcat(outseq, uv[uindex].u_value);
  1241.                 strcat(outseq, "\r");
  1242.  
  1243.                 /* and add it as a line into the buffer */
  1244.                 if (linstr(outseq) != TRUE)
  1245.                         return(FALSE);
  1246.         }
  1247.  
  1248.         curwp->w_bufp->b_mode |= MDVIEW;/* put this buffer view mode */
  1249.         curbp->b_flag &= ~BFCHG;        /* don't flag this as a change */
  1250.         wp->w_dotp = lforw(bp->b_linep);/* back to the beginning */
  1251.         wp->w_doto = 0;
  1252.         upmode();
  1253.         mlerase();      /* clear the mode line */
  1254.         return(TRUE);
  1255. }
  1256.  
  1257. /*      describe-functions      Bring up a fake buffer and list the
  1258.                                 names of all the functions
  1259. */
  1260.  
  1261. PASCAL NEAR desfunc(f, n)
  1262.  
  1263. {
  1264.         register WINDOW *wp;    /* scanning pointer to windows */
  1265.         register BUFFER *bp;    /* buffer to put binding list into */
  1266.         register int uindex;    /* index into funcs table */
  1267.         register int cmark;     /* current mark */
  1268.         char outseq[80];        /* output buffer for keystroke sequence */
  1269.  
  1270.         /* split the current window to make room for the variable list */
  1271.         if (splitwind(FALSE, 1) == FALSE)
  1272.                         return(FALSE);
  1273.  
  1274.         /* and get a buffer for it */
  1275.         bp = bfind(TEXT211, TRUE, 0);
  1276. /*                 "Function list" */
  1277.         if (bp == NULL || bclear(bp) == FALSE) {
  1278.                 mlwrite(TEXT212);
  1279. /*                      "Can not display function list" */
  1280.                 return(FALSE);
  1281.         }
  1282.  
  1283.         /* let us know this is in progress */
  1284.         mlwrite(TEXT213);
  1285. /*              "[Building function list]" */
  1286.  
  1287.         /* disconect the current buffer */
  1288.         if (--curbp->b_nwnd == 0) {             /* Last use.            */
  1289.                 curbp->b_dotp  = curwp->w_dotp;
  1290.                 curbp->b_doto  = curwp->w_doto;
  1291.                 for (cmark = 0; cmark < NMARKS; cmark++) {
  1292.                         curbp->b_markp[cmark] = curwp->w_markp[cmark];
  1293.                         curbp->b_marko[cmark] = curwp->w_marko[cmark];
  1294.                 }
  1295.                 curbp->b_fcol  = curwp->w_fcol;
  1296.         }
  1297.  
  1298.         /* connect the current window to this buffer */
  1299.         curbp = bp;     /* make this buffer current in current window */
  1300.         bp->b_mode = 0;         /* no modes active in binding list */
  1301.         bp->b_nwnd++;           /* mark us as more in use */
  1302.         wp = curwp;
  1303.         wp->w_bufp = bp;
  1304.         wp->w_linep = bp->b_linep;
  1305.         wp->w_flag = WFHARD|WFFORCE;
  1306.         wp->w_dotp = bp->b_dotp;
  1307.         wp->w_doto = bp->b_doto;
  1308.         for (cmark = 0; cmark < NMARKS; cmark++) {
  1309.                 wp->w_markp[cmark] = NULL;
  1310.                 wp->w_marko[cmark] = 0;
  1311.         }
  1312.  
  1313.         /* build the function list */
  1314.         for (uindex = 0; uindex < NFUNCS; uindex++) {
  1315.  
  1316.                 /* add in the environment variable name */
  1317.                 strcpy(outseq, "&");
  1318.                 strcat(outseq, funcs[uindex]);
  1319.                 strcat(outseq, "\r");
  1320.  
  1321.                 /* and add it as a line into the buffer */
  1322.                 if (linstr(outseq) != TRUE)
  1323.                         return(FALSE);
  1324.         }
  1325.  
  1326.         linstr("\r");
  1327.  
  1328.         curwp->w_bufp->b_mode |= MDVIEW;/* put this buffer view mode */
  1329.         curbp->b_flag &= ~BFCHG;        /* don't flag this as a change */
  1330.         wp->w_dotp = lforw(bp->b_linep);/* back to the beginning */
  1331.         wp->w_doto = 0;
  1332.         upmode();
  1333.         mlwrite("");    /* clear the mode line */
  1334.         return(TRUE);
  1335. }
  1336.  
  1337. pad(s, len)     /* pad a string to indicated length */
  1338.  
  1339. char *s;        /* string to add spaces to */
  1340. int len;        /* wanted length of string */
  1341.  
  1342. {
  1343.         while (strlen(s) < len) {
  1344.                 strcat(s, "          ");
  1345.                 s[len] = 0;
  1346.         }
  1347. }
  1348. #endif
  1349.